00010	BEGIN "FIX"
00020	DEFINE ⊂="COMMENT";⊂ 7/27/72  This is a fast version of LIS.SAI;
00030	
00040	REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00050	REQUIRE "PRELPC[1,ALS]" LOAD_MODULE;
00065	REQUIRE "LPC2[SYS,ALS]" LOAD_MODULE;
00070	FORTRAN REAL PROCEDURE SQRT(REAL X);
00080	FORTRAN REAL PROCEDURE ALOG10(REAL X);
00090	FORTRAN REAL PROCEDURE COS(REAL X);
00100	FORTRAN REAL PROCEDURE SIN(REAL X);
00110	INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00120	EXTERNAL PROCEDURE PREPARE; EXTERNAL FORTRAN PROCEDURE LPC1
00130		(REFERENCE REAL A,B,R0,C;REFERENCE INTEGER N,I,J);
00140	DEFINE BPS="12",DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
00150	DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00160	STRING FILEL,FILI,TFILEI,TFILE,FILEI;
00170	SAFE INTEGER ARRAY DATBUF[0:BUFSIZ];
00180	SAFE INTERNAL INTEGER ARRAY LIST[0:1];	⊂ Needed but not used;
00190	SAFE INTEGER ARRAY LFILE[0:127],INDATA[0:640];
00200	SAFE INTERNAL REAL ARRAY A,B,C[0:256];
00210	REAL X,SX; SAFE REAL ARRAY WINDOW[0:256];
00220	DEFINE INSIZ="24"; SAFE INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00230	SAFE INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00240	INTEGER CHAN2,CHAN4,CHAN5,EOF,IEOF,EOFA,BRK,BPT,BPTFST,BPTSAV,
00250	  LBPT,SEGCNT,SEGTOT,H,I,J,K,L;
00260	INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG,SEGC,SEGMRK,SEGSAV;
00270	INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH,I1L,I1H,I2L,I2H,I3L,
00280	 I3H,INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,ILPB,ILPC,IHPB,IHPC ;
00290	INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00300	INTERNAL INTEGER TFLAG,ZEROF,ZEROC;
00310	INTERNAL REAL R0 ;INTERNAL INTEGER NP,NZ,FP1,FP2,FZ ;
00320	INTERNAL REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
00330	INTERNAL INTEGER ARRAY FF[1:5] ; INTERNAL REAL ARRAY AMP[1:5] ;
00340	LABEL START;
00350	STRING READ1,READ2,PREHINT; INTEGER HINCNT,HCOUNT,HINDEX;
00360	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00370	
00380	UPCNT←3;FILEL←"LIST1";FILEI←"INSERT.DAT[1,THO]";M←8;INFLAG←0;
00390	 CHAN2←2; CHAN4←4; CHAN5←5;
00400	IF (TFILEI←STRIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
00410	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00420	LOOKUP(CHAN5,FILEL,1); EOFA←0;
00430	 M←8; N←2↑M; NF←2*N; DEFINE PI="3.141592653";
00440	FOR I←0 STEP 1 UNTIL N DO  WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00450	OUTSTR(CRLF&"Shift DATABUF by WORDS = "); DATSHIFT←CVD(INCHWL);
00460	OUTSTR(CRLF);
00470	START:	WHILE EOFA=0 DO BEGIN "LISTREAD"
00480	HINDEX←21; HCOUNT←HINCNT←0; FILEI←INPUT(CHAN5,1);
00490	IF EOFA≠0 THEN BEGIN
00500	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00510	LOOKUP(CHAN5,FILEL,1); EOFA←0;
00520	DATSHIFT←DATSHIFT+1;OUTSTR("DATSHIFT set to "&CVS(DATSHIFT)&CRLF);
00530	DONE; END; 
00540	CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00550	LOOKUP(CHAN4,FILEI,1); ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00560	EOF←0; SEGC←0; SEGCNT←0; SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00570	IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00580	OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segs"&CRLF);
00590	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,10,0,0,0); TFILE←"";
00600	FOR I←0 STEP 1 UNTIL 9 DO BEGIN
00610	  TFILEI←FILEI[1 TO 1];   IF TFILEI="." THEN DONE;
00620	  TFILE←TFILE&TFILEI;  FILEI←FILEI[2 TO 9]; END;
00630	SETFORMAT(1,0); TFILE←TFILE&".L"&CVS(DATSHIFT);
00640	ENTER(CHAN2,TFILE,0); ARRYOUT(CHAN2,LFILE[0],'200); ⊂ Copy header;
00650	FOR I←0 STEP 1 UNTIL 639 DO INDATA[I]←0;
00660	⊂ THE PARA LIMITS ARE (DOUBLE CHECK)  F1=200/800  F2=700/2050
00670	     F3=2000/3200     NP=800/1500  NZRNG=NP+/-500 ?
00680	    FP1=1800/3200   FP2=3200/5000   LPE=300/450  HPE=2500/3000 ;
00690	⊂  *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00700	   SX←RATE/N;  I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX;
00710	 I2H←2050./SX+.5;    I3L←1950./SX; I3H←3250./SX+.5; 
00720	   INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
00730	   FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
00740	   ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
00750	BPTFST←POINT(BPS,DATBUF[0],-1);
00760	IF DATSHIFT>0 THEN  ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00770	ARRYIN(CHAN4,DATBUF[0],BUFEXS); SEGMRK←SEGC←K←1;
00780	WHILE EOF=0 DO  BEGIN
00790	  IF SEGC>SEGTOT THEN DONE;  ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
00800	  IF EOF≠0 THEN BEGIN  J←EOF LAND '777777;
00810	   FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0; END;
00820	K←1;   BPT←BPTFST; SEGSAV←SEGC;
00830	WHILE K≤6*DATSIZ%N DO BEGIN
00840	 IF (J←SEGMRK-SEGC)>0 THEN BEGIN  FOR I←1 STEP 1 UNTIL J DO BEGIN
00850	  BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
00860	 K←K+J; SEGC←SEGMRK; END;
00870	IF SEGC>SEGTOT THEN DONE; IF K>6*DATSIZ%N THEN DONE; BPTSAV←BPT;
00880	FOR I←0 STEP 1 UNTIL N-1 DO A[I]←BYTE;
00890	 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
00900	 ⊂  LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
00910	I←24; J←N%2; LPC1(A[0],B[0],R0,C[0],N,I,J);
00920	 PREPARE; I←(SEGC-1)*4; L←0;
00930	  FOR P←0 STEP 1 UNTIL 23 DO BEGIN
00940	   IF INDAT[P]<0 THEN INDAT[P]←0; IF INDAT[P]>63 THEN INDAT[P]←63;
00950	   H←(H LSH 6)+INDAT[P];
00960	   IF L<5 THEN L←L+1 ELSE BEGIN INDATA[I]←H; L←0; I←I+1;END;
00970	  END; SEGMRK←SEGC+1;
00980	IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE; END; ⊂ End of WHILE K≤ ;
00990	SEGC←SEGSAV+6*DATSIZ%N; K←1;
01000	FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
01010	FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0; END;
01020	ARRYOUT(CHAN2,INDATA[0],SEGTOT*4); CLOSE(CHAN2);
01030	OUTSTR(TFILE&" has been written."&CRLF);
01040	IF EOFA≠0 THEN DONE; END "LISTREAD"; GO TO START; END "FIX";